
package Sgdb::DataPanesWin ;
use Sgdb::Utils qw (:DEFAULT
                    create_window
                    ) ;

use Sgdb::DataMessagesPane ;
use Sgdb::DataTracepoints ;
use Sgdb::DataActions ;
use Sgdb::DataBreakpoints ;
use Sgdb::DisplayRegisters ;
use Sgdb::Cntr::Controler ;
use Sgdb::DisplayWatch ;


# pragmas for all
use warnings ;
use strict ;
use integer ;
use bytes ;

my ( $notebook, $update_cmd,  $update_type) ;

init() ;

sub init { 1 }

sub new {
    my $self = shift or die "whoami" ;
    my $topf = shift or die "top frame needed" ;
    my $frame = $topf -> Frame ;
                                # this intermediate frame is yielding better geometry
                                # responses (can be considered as bug fix)
    $notebook = $frame->NoteBook () ;

    add_pane ( 'Message', 'Sgdb::DataMessagesPane' ) ;

    hook_add ( 'show-data-tracepoints',   [\&add_pane, qw/Tracepoints Sgdb::DataTracepoints refresh-breakpoints/] ,
               'show-data-breakpoints',   [\&add_pane, qw/Breakpoints Sgdb::DataBreakpoints refresh-breakpoints/] ,

               'add-display-registers',   [\&add_pane, qw/Registers Sgdb::DisplayRegisters new-frame-update/ ] ,
               'add-display-watch',       [\&add_pane, qw/Watch     Sgdb::DisplayWatch     new-frame-update/ ] ,
               'add-display-collected',   [\&add_pane, qw/Collected Sgdb::DisplayCollected new-frame-update/ ] ,
               'add-watch',               [\&add_pane, qw/Watch     Sgdb::DisplayWatch     new-frame-update/ ] ,

               'show-data-messages',      [\&add_pane, qw/Message   Sgdb::DataMessagesPane  /] ,
               'add-inlines-right-pane',  [\&add_pane, qw/Inlines   Sgdb::InlinesPane       /] ,
               'set-tracepoint-action',   [\&add_pane, qw/Actions   Sgdb::DataActions       /] ,
               'show-emc-checkfix',       [\&add_pane, qw/ChkFix    Sgdb::Cntr::Controler   /] ,
               'show-other-emc-checkfix', [\&create_window, 'Sgdb::Cntr::Controler', 'Fix Checker', 'controller', 'sgdbtk', 1 ] ,
               'show-emc-make-patch',     [\&add_pane, qw/ChkFix    Sgdb::Cntr::Controler   /] ,
               'add-profiler-pane',       [\&add_pane, qw/Profiler  Sgdb::Cntr::ProfilerPane/] ,
               'add-passive-prof-pane',   [\&add_pane, qw/Passive   Sgdb::Cntr::PassiveProf /] ,
               'add-branch-prof-pane',    [\&add_pane, qw/Branch    Sgdb::Cntr::BranchProf  /] ,
               'add-status-pane',         [\&add_pane, qw/Status    Sgdb::Cntr::StatusPane  /] ,
               'symbol-lookup',           [\&add_pane, qw/Symbol    Sgdb::Cntr::SymbolLookup/] ,
               'usage-lookup',            [\&add_pane, qw/Usage     Sgdb::Cntr::UsageLookup /] ,
               'etags-lookup',            [\&add_pane, qw/Etags     Sgdb::Cntr::Etags       /] ,
               # 'add-monitor-pane',        [\&add_pane, qw/Monitor   Sgdb::Cntr::Monitor     /] ,
               'add-function-call-pane',  [\&add_pane, qw/Function  Sgdb::Cntr::FunctionCall/] ,
               'add-swuch-pane-now',      [\&add_swucn_pane                                  ] ,

               'close-current-data-pane', [\&close_current_data,    $notebook                ] ,
               'new-frame-update',        [\&update_data, 'new-frame-update'                 ] ,
               'refresh-breakpoints',     [\&update_data, 'refresh-breakpoints'              ] ,

             ) ;


#    bindkey 'C-i' => [\&hook_run, 'add-inlines-right-pane'] => ' Raise and focus Inlines Pane'  ;
#    bindkey 'C-r' => [\&hook_run, 'add-display-registers' ] => ' Raise and focus Registers Pane' ;
#    bindkey 'C-w' => [\&hook_run, 'add-display-watch'     ] => ' Raise and focus Watch Pane'  ;


    $notebook -> pack (-fill => 'both',
                       -expand => 1,
                       ) ;

    $frame ;
}

sub close_current_data {

    my $n = $notebook ;
    my $r = $n -> raised () or return telme 'nothing up' ;

    $update_type = '' ;

    $n -> delete ( $r ) ;
}

sub add_pane {
    my ($name, $package, $type, @params ) = @_ ;

    return telme 'no notebook' unless istkwidget $notebook ;

    unless ( defined $notebook -> page_widget( $name ) ) {

        unless ( 'CODE' eq ref $package ) {
            my $p = $package ;

            $p =~ s/\:\:/\//g ;
            $p .= '.pm' ;
            require $p or return telthemloud "Error: $@" ;
        }

        my $frame = $notebook -> add ( $name,
                                       -label => $name,
                                       -anchor => 'w',
                                       ) ;

        my ($text, $cmd) =
          ( 'CODE' eq ref $package ?
            $package ->     ($frame, @params) :
            $package -> new ($frame, @params) ) ;

        my $raisecmd = sub {
            if ( $type and 'CODE' eq ref $cmd ) {
                $update_type = $type ;
                $update_cmd  = $cmd ;
                $cmd -> () ;
            }
            else {
                $update_type = '' ;
            }
        } ;


        $notebook -> pageconfigure ( $name,
                                     -raisecmd => $raisecmd
                                     ) ;
        $text -> pack ( -fill => 'both',
                        -expand => 'y',
                      );
    }
    $notebook -> raise ( $name ) ;
}

sub add_swucn_pane {

    my $name = 'Swuch' ;

    return telme 'no notebook' unless istkwidget $notebook ;

    unless ( defined $notebook -> page_widget( $name ) ) {

        require Swuch::Window or return telthemloud "Error: $@" ;

        my $frame = $notebook -> add ( $name,
                                       -label     => $name,
                                       -anchor    => 'w',
                                       ) ;

        new Swuch::Window ($frame, 2) ;

        hook_add 'close-swuch' => sub {
            $notebook -> delete( $name ) if 
              defined $notebook -> page_widget( $name )
        } ;
    }
    $notebook -> raise ( $name ) ;
    focus_on $Swuch::Window::entryCommand ;
}

sub update_data {

    return unless $update_type eq shift ;
    $update_cmd -> ( @_ ) ;
}

'end'
